perm filename ANSWER.NEW[1,JRA]4 blob sn#030165 filedate 1973-03-16 generic text, type T, neo UTF8
00100	
00200	
00300	(DEFPROP ALLPOS 
00400	 (LAMBDA (C) (LIST (QUOTE NULL) (LIST (QUOTE CADAR) (CADR C)))) 
00500	MACRO)
00600	
00700	(DEFPROP ALLNEG 
00800	 (LAMBDA (C) (LIST (QUOTE EQ) (LIST (QUOTE CADAR) (CADR C)) (LIST (QUOTE CDR) (CADR C)))) 
00900	MACRO)
01000	
01100	(DEFPROP ANCESTOR 
01200	 (LAMBDA (X) (LIST (QUOTE CDDDAR) (CADR X))) 
01300	MACRO)
01400	
01500	(DEFPROP SEARCH1 
01600	 (LAMBDA (X) (LIST (QUOTE SEARCH2) (CADR X) (CADDR X) NIL)) 
01700	MACRO)
01800	
01900	(DEFPROP CONST 
02000	 (LAMBDA (X) (LIST (QUOTE NULL) (LIST (QUOTE CDR) (CADR X)))) 
02100	MACRO)
02200	
02300	(DEFPROP HERE 
02400	 (LAMBDA (X) (LIST (QUOTE CAAR) (CADR X))) 
02500	MACRO)
02600	
02700	(DEFPROP VAR 
02800	 (LAMBDA (L) (LIST (QUOTE NUMBERP) (CADR L))) 
02900	MACRO)
03000	
03100	(DEFPROP ISCLS 
03200	 (LAMBDA (L) (LIST (QUOTE EQ) (CADR L) 1)) 
03300	MACRO)
03400	
03500	(DEFPROP ISCL 
03600	 (LAMBDA (L) (LIST (QUOTE EQ) (CADR L) 2)) 
03700	MACRO)
03800	
03900	(DEFPROP ISLIT 
04000	 (LAMBDA (L) (LIST (QUOTE EQ) (CADR L) 3)) 
04100	MACRO)
04200	
04300	(DEFPROP ISTRM 
04400	 (LAMBDA (L) (LIST (QUOTE EQ) (CADR L) 4)) 
04500	MACRO)
04600	
04700	(DEFPROP MKWRD 
04800	 (LAMBDA (L) (LIST (QUOTE CDDAR) (CADR L))) 
04900	MACRO)
05000	
05100	(DEFPROP NEG 
05200	 (LAMBDA (X) (LIST (QUOTE EQ) (QUOTE ESCAPE) (LIST (QUOTE CAR) (CADR X)))) 
05300	MACRO)
05400	
05500	(DEFPROP NEGBIT 
05600	 (LAMBDA (X) (LIST (QUOTE CDDAAR) (CADR X))) 
05700	MACRO)
05800	
05900	(DEFPROP POS 
06000	 (LAMBDA (X) (LIST (QUOTE NOT) (LIST (QUOTE NEG) (CADR X)))) 
06100	MACRO)
06200	
06300	(DEFPROP POSBIT 
06400	 (LAMBDA (X) (LIST (QUOTE CADAAR) (CADR X))) 
06500	MACRO)
06600	
06700	(DEFPROP SEARCH 
06800	 (LAMBDA (X) (LIST (QUOTE SEARCH2) (CADR X) (CADDR X) (CADR X))) 
06900	MACRO)
07000	
07100	(DEFPROP NEGL 
07200	 (LAMBDA (C) (LIST (QUOTE CADAR) (CADR C))) 
07300	MACRO)
     

00100	
00200	(DE VINE(X)(ATOM(CDR(ANCESTOR X))) )
00300	
00400	(DEFPROP ALPHABETIC 
00500	 (LAMBDA(R L)
00600	  (PROG NIL
00700	   A    (COND ((OR (NULL L) (NULL (CAR L))) (RETURN R))
00800		      ((NOT (EQ (LENGTH (CDR R)) (LENGTH (CDAR L)))) (GO B))
00900		      ((ALPHAV (CDR R) (CDAR L) NIL) (RETURN (CAR L))))
01000	   B    (SETQ L (CDR L))
01100		(COND (L (GO A)) (T (RETURN NIL))))) 
01200	EXPR)
01300	
01400	(DEFPROP ALPHAV 
01500	 (LAMBDA(C1 C2 L)
01600	  (PROG NIL
01700	   AL1  (COND ((NULL C1) (RETURN T)) ((NEG (CAR C1)) (GO AL3)) ((NOT (EQ (CAAR C1) (CAAR C2))) (RETURN NIL)))
01800		(SETQ L (ANSUNI (CDAR C1) (CDAR C2) L))
01900	   AL2  (COND ((NULL L) (RETURN NIL)))
02000		(SETQ C1 (CDR C1))
02100		(SETQ C2 (CDR C2))
02200		(GO AL1)
02300	   AL3  (COND ((POS (CAR C2)) (RETURN NIL))
02400		      ((EQ (CADAR C1) (CADAR C2)) (SETQ L (ANSUNI (CDDAR C1) (CDDAR C2) L)) (GO AL2)))
02500		(RETURN NIL))) 
02600	EXPR)
02700	
02800	(DEFPROP ANSPRED 
02900	 (LAMBDA NIL (ANSPRINT (STAGE1 (ANSWER (CONS LHP RHP))))) 
03000	EXPR)
03100	
03200	(DEFPROP ANSPRINT 
03300	 (LAMBDA(L)
03400	  (PROG (Z VARL ONO)
03500		(SETQ ONO 0)
03600	   B    (PRINC (QUOTE /())
03700		(SETQ Z (CDAR L))
03800	   A    (COND ((NEG (CAR Z)) (PRFPR1 (CDAR Z))) (T (PRFPR1 (CONS ESCAPE (CAR Z)))))
03900		(SETQ Z (CDR Z))
04000		(COND (Z (PRINC (QUOTE / )) (PRINC (QUOTE ∧)) (PRINC (QUOTE / )) (GO A)))
04100		(PRINC (QUOTE /)))
04200		(SETQ L (CDR L))
04300		(COND (L (PRINC (QUOTE / )) (PRINC (QUOTE ∨)) (PRINC (QUOTE / )) (GO B)))
04400		(RETURN NIL))) 
04500	EXPR)
04600	
04700	(DEFPROP